home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1991: Code Warrior / bincue / Code Warrior.bin / Developer Essentials / DTS Sample Code / Snippets / Snippets May '91 / MDEF.Sample / pMyMDEF.p < prev    next >
Encoding:
Text File  |  1991-09-09  |  9.2 KB  |  420 lines  |  [TEXT/MPS ]

  1. {$R-}
  2. UNIT MDEFunit;
  3.  
  4. INTERFACE
  5.  
  6. USES Memtypes, Quickdraw, OSIntf, ToolIntf,PackIntf;
  7.  
  8. procedure MyMenu (message: integer; theMenu: MenuHandle; var MenuRect: rect; hitPt: point; var whichitem: integer);
  9.  
  10. IMPLEMENTATION
  11.  
  12. CONST
  13.         normaltext =    0;
  14.         boldtext =        1;
  15.         italictext =    2;
  16.         underlinetext =    4;
  17.         outlinetext = 8;
  18.         shadowtext = 16;
  19.         condensetext = 32;
  20.         extendtext = 64;
  21.      
  22.         mygray = 'AA55AA55AA55AA55';
  23.         FIRST_5_FIELDS = 14;
  24.         FOUR_BYTES = 4;
  25.         INSET_VALUE = 12;
  26.         TEXT_FACE_OFFSET = 3;
  27.         itemheight = 16;
  28.  
  29.  
  30. PROCEDURE DrawItem(item: Integer; ItemRect: Rect; theMenu: MenuHandle); FORWARD;
  31.  
  32. PROCEDURE DrawMenu(theMenu: MenuHandle; MenuRect: Rect); FORWARD;
  33.  
  34. PROCEDURE SizeMenu(theMenu: MenuHandle); FORWARD;
  35.  
  36.  
  37. function ItemRect (item: integer; MenuRect: Rect): rect; FORWARD;
  38.  
  39. procedure MyMenu (message: integer; theMenu: MenuHandle; var MenuRect: rect; 
  40.                     hitPt: point; var whichitem: integer);
  41.     const
  42.         itemheight = 16;
  43.     type
  44.         TwoIntsMakeAlong = RECORD
  45.             CASE INTEGER OF
  46.                 0: (Hi: INTEGER;
  47.                     Low: INTEGER);
  48.                 1: (HiAndLow: Longint);
  49.             END;
  50.             
  51.         mbsavelocRec = RECORD
  52.                 Mystery: PACKED ARRAY[0..5] OF Byte;
  53.                 saveRect: Rect;
  54.                 unknownWord: Integer;
  55.                 FlagWord: Integer;
  56.         END;
  57.         mbsavelocPtr = ^mbsavelocRec;
  58.         mbsavelocHandle = ^mbsavelocPtr;
  59.     var
  60.         y: integer;
  61.         temp: integer;
  62.         box: rect;
  63.         MenuChoicePtr: ^longint;
  64.         AtMenuBotPtr:    ^integer;
  65.         mbsaveholder: ^mbsavelocHandle;
  66.         oldwhichitem: integer;
  67.         mbsavehdl: mbsavelocHandle;
  68.         s: Str255;
  69.         TheChoice: TwoIntsMakeAlong;
  70.         temprect: Rect;
  71.         
  72.         t:    MenuHandle;
  73.         
  74. procedure InvertItem (item: integer; leaveblack: Boolean);
  75.     VAR
  76.         r: Rect;
  77.         rhdl: RgnHandle;
  78.     begin
  79.         GetClip(rhdl);
  80.         r := ItemRect(item,MenuRect);
  81.         EraseRect(r);
  82.         ClipRect(r);
  83.         DrawItem(item,r,theMenu);
  84.         SetClip(rhdl);
  85.         IF leaveblack THEN
  86.             InvertRect(r);
  87.     end;
  88.  
  89.         
  90.     
  91. begin
  92.     case message of
  93.         mDrawMsg: 
  94.             DrawMenu(theMenu, MenuRect);
  95.             
  96.         mChooseMsg: 
  97.             begin
  98.                 oldwhichitem := whichitem;
  99.                 whichitem := 0;
  100.                 MenuChoicePtr := pointer($B54);
  101.  
  102.                 if PtInRect(hitPt, MenuRect) then
  103.                     begin
  104.                     
  105.                         y := ((hitpt.v - MenuRect.top) div itemheight) + 1;
  106.                         
  107.                         {get item rect}
  108.                         temprect := itemrect(y,MenuRect);
  109.                         mbsaveholder := pointer($B5C);
  110.                         mbsavehdl := mbsaveholder^;
  111.                         
  112.                         {store it in mbSaveLoc}
  113.                         temp := themenu^^.menuid;
  114.                         TheChoice.hi := themenu^^.menuid;
  115.                         TheChoice.low := y;
  116.                         MenuChoicePtr^ := TheChoice.HiAndLow;
  117.                         
  118.                         whichItem := y;
  119.                         {}
  120.                         
  121.                         if whichitem <> oldwhichitem then
  122.                             
  123.                             begin
  124.                                 IF ( BTST(theMenu^^.enableFlags,whichitem)) THEN BEGIN
  125.                                     InvertItem(WhichItem,TRUE);
  126.                                     InvertItem({y}oldwhichitem,FALSE);
  127.                                 END
  128.                                 ELSE BEGIN
  129.                                     InvertItem(oldwhichitem,FALSE);
  130.                                     whichItem := 0;
  131.                                 END;
  132.                             end;
  133.                         mbsavehdl^^.saveRect := TempRect;
  134.                         mbsavehdl^^.FlagWord := 1;
  135.                         
  136.                     end
  137.                 else
  138.                     begin
  139.                         InvertItem(oldWhichItem,FALSE);
  140.                         TheChoice.hi := theMenu^^.menuID;
  141.                         TheChoice.low := 0;
  142.                         MenuChoicePtr^ := TheChoice.HiAndLow;
  143.                     end;
  144.             end;
  145.         mSizeMsg: 
  146.             SizeMenu(theMenu);
  147.         otherwise
  148.             sysbeep(10);
  149.     end;
  150. end;
  151.  
  152. function ItemRect (item: integer; MenuRect: Rect): rect;
  153.     VAR
  154.         box: Rect;
  155.     begin
  156.         if item > 0 then
  157.             begin
  158.                 box := MenuRect;
  159.                 box.top := box.top + (item - 1) * itemheight;
  160.                 box.bottom := box.top + itemheight;
  161.             end
  162.         else
  163.             SetRect(box, 0, 0, 0, 0);
  164.         ItemRect := box;
  165.     end;
  166.     
  167.  
  168.  
  169.  
  170.  
  171. PROCEDURE GetStyle(stylenumber: SignedByte; VAR theStyle: Style);
  172. VAR
  173.     selector: Integer;
  174. BEGIN
  175.     CASE stylenumber OF
  176.         normaltext:    
  177.             theStyle := [];
  178.         boldtext: 
  179.             theStyle := [bold];
  180.         italictext:  
  181.             theStyle := [italic];
  182.         underlinetext: 
  183.             theStyle := [underline];
  184.         outlinetext:    
  185.             theStyle := [outline];    
  186.         shadowtext: 
  187.             theStyle := [shadow];
  188.         condensetext:
  189.             theStyle := [condense];
  190.         extendtext:
  191.             theStyle := [extend];
  192.         otherwise
  193.             theStyle := [];
  194.     END;
  195. END;
  196.  
  197.  
  198. PROCEDURE DrawItem(item: Integer; ItemRect: Rect; theMenu: MenuHandle);
  199.     
  200. VAR
  201.     hierIconRect:     Rect;
  202.     shiftIconRect:     Rect;
  203.     SICNHdl:        Handle;
  204.     fontmetrics:     FontInfo;
  205.     graypat:        Pattern;
  206.     titlelenght:     Integer;
  207.     thestyle:        Style;
  208.     gp:                GrafPtr;
  209.     I:                 Integer;
  210.     bm:                BitMap;
  211.     titleLength:    Integer;
  212.     dataPtr:        Ptr;
  213.     tempptr:        Ptr;
  214.     
  215. BEGIN
  216.     {make a gray}
  217.     StuffHex(@graypat,mygray);
  218.     {set the rects for our special icons}
  219.     hierIconRect := ItemRect;
  220.     hierIconRect.left := hierIconRect.right - 16;
  221.     
  222.     shiftIconRect.top := ItemRect.top;
  223.     shiftIconRect.bottom := ItemRect.bottom;
  224.     shiftIconRect.right := hierIconRect.left - 3;
  225.     shiftIconRect.left := shiftIconRect.right - 16;
  226.     
  227.     {now get our 2 SICN's}
  228.     SICNHdl := GetResource('SICN',128);  {no checking now we will check whenever we use it}
  229.     
  230.     IF SICNHdl <> NIL THEN BEGIN {we got it make it a bitmap}
  231.         HNoPurge(SICNHdl);
  232.         SetRect(bm.bounds,0,0,16,16);
  233.         bm.rowBytes := 2;
  234.     END;
  235.     
  236.     
  237.     {how long is the title}
  238.     WITH theMenu^^ DO
  239.     titlelength := ORD(menuData[0]) + 1;
  240.     
  241.     {point past it}
  242.     HLock(Handle(theMenu));
  243.     
  244.     {here is where pascal gets to be a pain, C too for that matter}
  245.     WITH theMenu^^ DO
  246.     dataPtr := POINTER(ORD4(@menudata) + titlelength);
  247.     
  248.     FOR I := 1 TO item-1 DO  {get to the item's data}
  249.         dataPtr := POINTER(ORD4(dataPtr) + dataPtr^ + FOUR_BYTES + 1);
  250.         
  251.     {now we are pointing at the data for the item we care about}
  252.     IF StringPtr(dataptr)^ = '-' THEN BEGIN
  253.         PenPat(graypat);
  254.         MoveTo(ItemRect.left,ItemRect.top + 8);
  255.         LineTo(ItemRect.right,ItemRect.top + 8);
  256.         PenNormal;
  257.     END
  258.     ELSE BEGIN
  259.         {what is the typeface}
  260.         tempptr := POINTER(ORD4(dataptr) + dataPtr^ + 1 + TEXT_FACE_OFFSET);
  261.         GetStyle(tempptr^,thestyle);
  262.         TextFace(thestyle);
  263.         GetFontInfo(FontMetrics);
  264.         MoveTo(ItemRect.left + INSET_VALUE,ItemRect.bottom - FontMetrics.descent);
  265.         DrawString(StringPtr(dataPtr)^);
  266.         TextFace([]);
  267.         
  268.         {look at the icon bit, we don't support real icons (its too hard to figure item height)}
  269.         {anyway they look stupid in menus}
  270.         tempptr := POINTER(ORD4(dataptr) + dataPtr^ + 1);
  271.         IF tempptr^ = 1 THEN {it is  a shift command item so draw the shift icon}
  272.             IF SICNHdl <> NIL THEN BEGIN
  273.             
  274.                 GetPort(gp);
  275.                 HLock(SICNHdl);
  276.                 bm.baseAddr := SICNHdl^;
  277.                 CopyBits(bm,gp^.portBits,bm.bounds,shiftIconRect,srcCopy,nil);
  278.                 HUnlock(SICNHdl);
  279.             END;
  280.         
  281.         {check command key}
  282.         tempptr := POINTER(ORD4(tempptr) + 1);
  283.         IF tempptr^ > $1F THEN BEGIN  {draw the character}
  284.             MoveTo(ItemRect.right - 24,ItemRect.bottom - FontMetrics.descent);
  285.             DrawChar(CHR(17));
  286.             DrawChar(CharsPtr(tempptr)^[0]);
  287.         END
  288.         ELSE
  289.         IF tempptr^ = $1B THEN {we have a submenu so draw the indicator}
  290.             IF SICNHdl <> NIL THEN BEGIN
  291.             
  292.                 GetPort(gp);
  293.                 HLock(SICNHdl);
  294.                 bm.baseAddr := POINTER(ORD4(SICNHdl^) + 32);
  295.                 CopyBits(bm,gp^.portBits,bm.bounds,hierIconRect,srcCopy,nil);
  296.                 HUnlock(SICNHdl);
  297.             END;
  298.             
  299.         {finally if it is disabled }
  300.         IF (NOT BTST(theMenu^^.enableFlags,item)) THEN BEGIN
  301.             PenPat(graypat);
  302.             PenMode(patBic);
  303.             ItemRect.right := ItemRect.right - 2;
  304.             ItemRect.left := ItemRect.left + 4;
  305.             PaintRect(ItemRect);
  306.             PenNormal;
  307.         END;
  308.         
  309.         IF SICNHdl <> NIL THEN
  310.             HPurge(SICNHdl);
  311.         HUnlock(Handle(theMenu));
  312.     END;  {of drawing code}
  313. END;
  314.  
  315. PROCEDURE SizeMenu(theMenu: MenuHandle);
  316. CONST
  317.     ITEMHEIGHT = 16;
  318.     HierIconWidth = 16;
  319.     Slop = 18;
  320.     shiftIconWidth = 19;
  321. TYPE
  322.     FourBytes = PACKED ARRAY[0..3] OF SignedByte;
  323.     FourBytePtr = ^FourBytes;
  324. VAR
  325.     maxWidth: Integer;
  326.     dataPtr:    Ptr;
  327.     numItems:    Integer;
  328.     tempwidth:  Integer;
  329.     AddSlop:    Boolean;
  330.     I: Integer;
  331.     
  332. BEGIN
  333.  
  334.     {we use stringwidth so lock the menuhandle}
  335.     HLock(Handle(theMenu));
  336.     
  337.     WITH theMenu^^ DO
  338.         dataPtr := @menudata;
  339.     
  340.     {move past the title}
  341.     dataPtr := POINTER(ORD4(dataPtr)+dataPtr^+1);
  342.     
  343.     numItems := CountMItems(theMenu);
  344.     theMenu^^.menuHeight := numItems * ItemHeight;  {gross, but simple}
  345.     
  346.     {now figure out the width}
  347.     maxWidth := INSET_VALUE;
  348.     AddSlop := FALSE;
  349.     FOR I := 1 TO numItems DO BEGIN
  350.     
  351.         IF dataPtr^ <> ORD('-') THEN BEGIN  {the lines are as long as the longest item}
  352.             TextFont(0);
  353.             tempwidth := StringWidth(StringPtr(dataPtr)^) + 4;
  354.             
  355.             {increment dataPtr to point at do-dads}
  356.             dataPtr := POINTER(ORD4(dataPtr)+dataPtr^+1); {first at icon byte}
  357.             
  358.             IF FourBytePtr(dataPtr)^[0] = 1 THEN BEGIN  {uses shift icon}
  359.                 tempwidth := tempwidth + shiftIconWidth ;
  360.                 AddSlop := TRUE;
  361.             END;
  362.             
  363.             {dataPtr := POINTER(ORD4(dataPtr)+1);} {now at command byte}
  364.             IF FourBytePtr(dataPtr)^[1] > $1F THEN BEGIN
  365.                 tempwidth := tempwidth + CharWidth(CHR(17)) + CharWidth(CharsPtr(dataPtr)^[1]); 
  366.                              { CharWidth(CHR(dataPtr^));}
  367.                 AddSlop := TRUE;
  368.             END
  369.             ELSE
  370.             IF FourBytePtr(dataPtr)^[1]  = $1B THEN BEGIN
  371.                 tempwidth := tempwidth + HierIconWidth;
  372.                 AddSlop := TRUE;
  373.             END;
  374.             
  375.             {don't feel like supporting Marks either.  I'll leave it as an exercise}
  376.             
  377.             IF AddSlop THEN
  378.                 tempwidth := tempwidth + Slop;
  379.                 
  380.             IF tempwidth > maxWidth THEN
  381.                 maxWidth := tempwidth;
  382.                 
  383.             {add four to data ptr so we point at start of next string}
  384.             dataPtr := POINTER(ORD4(dataPtr)+4);
  385.         END;
  386.         
  387.         theMenu^^.menuWidth := maxWidth;
  388.     END;
  389.     HUnlock(Handle(theMenu));
  390. END;
  391.             
  392.             
  393.  
  394.             
  395.                 
  396.     
  397.     
  398.     
  399.     
  400.  
  401. PROCEDURE DrawMenu(theMenu: MenuHandle; MenuRect: Rect);
  402. VAR
  403.     numItems: Integer;
  404.     I : Integer;
  405.     theRect: Rect;
  406.  
  407. BEGIN
  408.     
  409.     numItems := CountMItems(theMenu);
  410.     
  411.     FOR I := 1 TO numItems DO BEGIN
  412.         theRect := ItemRect(I,MenuRect);
  413.         DrawItem(I,theRect,theMenu);
  414.     END;
  415.     
  416. END;
  417.     
  418. END.
  419.  
  420.